home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
oper_sys
/
emerald
/
emrldsys.lha
/
Language
/
Compiler
/
buildATs.c
< prev
next >
Wrap
C/C++ Source or Header
|
1990-08-16
|
14KB
|
459 lines
/*
* @(#)buildATs.c 1.5 1/20/89
*/
#include "assert.h"
#include "error.h"
#include "ident.h"
#include "nodes.h"
#include "builtins.h"
#include "symbols.h"
#include "sequence.h"
#include "MyParser.h"
#include "semantics.h"
#include "evaluate.h"
#include "buildATs.h"
#include "opNames.h"
#include "system.h"
#include "map.h"
#include "flags.h"
#include "environment.h"
#include "trace.h"
static int doClearSymbols = FALSE;
int compareSigs(a, b)
NodePtr *a, *b;
{
assert((*a)->tag == P_OPSIG);
assert((*a)->b.opsig.name->tag == P_OPNAME);
assert((*b)->tag == P_OPSIG);
assert((*b)->b.opsig.name->tag == P_OPNAME);
return((*a)->b.opsig.name->b.opname.id - (*b)->b.opsig.name->b.opname.id);
}
static Map copyMap;
NodePtr copyTree(), _copyTree();
#define COPYTREE(T) ((int)(T) <= 0x200 ? (T) : _copyTree(T))
void copySymbol(new, old)
NodePtr new, old;
{
register Symbol s = old->b.symdef.symbol;
register Symbol newS;
register NodePtr r;
NodePtr list;
register int mapResult;
mapResult = Map_Lookup(copyMap, (int)s);
if (old->tag == P_SYMDEF) {
newS = (Symbol) malloc(sizeof(STEntry));
*newS = *s;
Map_Insert(copyMap, (int)s, (int)newS);
if (mapResult == NIL) {
/* this is the first time we saw the symbol */
} else {
/* we need to fix previously seen symrefs */
assert(mapResult < 0);
list = (NodePtr) (-mapResult);
assert(list->tag == T_SEQUENCE);
Sequence_For(r, list)
assert(r->tag == P_SYMREF);
r->b.symref.symbol = newS;
Sequence_Next
free((char *) list);
}
if (doClearSymbols) {
newS->value.ATinfo = NULL;
newS->value.CTinfo = NULL;
newS->value.value = NULL;
newS->isManifest = FALSE;
newS->hasValue = FALSE;
} else {
newS->value.ATinfo = COPYTREE(s->value.ATinfo);
newS->value.CTinfo = COPYTREE(s->value.CTinfo);
newS->value.value = COPYTREE(s->value.value);
}
new->b.symdef.symbol = newS;
} else {
assert(old->tag == P_SYMREF);
if (mapResult != NIL && mapResult > 0) {
new->b.symref.symbol = (Symbol) mapResult;
} else {
if (mapResult == NIL) {
list = F_NewNode(T_SEQUENCE, 4);
Map_Insert(copyMap, (int)s, -(int)list);
} else {
list = (NodePtr) (-mapResult);
}
Sequence_Add(&list, new);
new->b.symref.symbol = old->b.symref.symbol;
}
}
}
static Boolean isExported(opname, exports)
register NodePtr opname, exports;
{
register NodePtr q, exportList;
if (exports == NN) return(FALSE);
exportList = exports->b.export.syms;
assert(opname->tag == P_OPNAME);
assert(isASequence(exportList));
Sequence_For(q, exportList)
assert(q->tag == P_OPNAME);
if (q->b.opname.id == opname->b.opname.id) return(TRUE);
Sequence_Next
return(FALSE);
}
NodePtr buildComplicatedSymbol();
extern void sortATOps();
NodePtr buildATOfObject(o)
NodePtr o;
{
register NodePtr at, p, ops, q;
register Symbol st, newst;
int stage;
assert(o->tag == P_OBLIT);
at = Construct(P_ATLIT, 4, o->b.oblit.sfname, NULL, NULL, NULL);
at->b.atlit.f.immutable = o->b.oblit.f.immutable;
TRACE4(copy, 1, "BuildATOf %s %s 0x%08x -> 0x%08x",
tagNames[(int)o->tag],
o->b.oblit.name == NN ? "unknown" :
ST_SymbolName(o->b.oblit.name->b.symdef.symbol),
o,
at);
st = ST_Fetch(o->b.oblit.name->b.symdef.symbol);
at->b.atlit.name =
buildComplicatedSymbol(P_SYMDEF, ST_SymbolName(st), 0, "_IAT");
at->b.atlit.name->b.symdef.symbol =
ST_Create(NN, at->b.atlit.name->b.symdef.ident);
newst = ST_Fetch(at->b.atlit.name->b.symdef.symbol);
newst->itsName = Ident_Name(newst->itsIdent);
at->b.atlit.name->b.symdef.ident = newst->itsIdent;
newst->value.value = at;
newst->value.ATinfo = refToBuiltin(B_INSTAT, SIGNATUREINDEX);
newst->value.CTinfo = refToBuiltin(B_INSTCT, SIGNATUREINDEX);
newst->isManifest = TRUE;
newst->hasValue = TRUE;
at->b.atlit.ops = NULL;
for (stage = 0; stage < 2; stage++) {
if (stage == 0) {
ops = o->b.oblit.monitor;
if (ops != NULL) {
assert(ops->tag == P_MONITOR);
ops = ops->b.monitor.ops;
}
} else if (stage == 1) {
ops = o->b.oblit.ops;
}
Sequence_For(p, ops)
assert(p->tag == P_OPDEF);
q = p->b.opdef.sig;
assert(q->tag == P_OPSIG);
#ifdef COPYSIGS
Sequence_Add(&at->b.atlit.ops, copyTree(q, TRUE));
#else
Sequence_Add(&at->b.atlit.ops, q);
#endif
p->b.opdef.isExported = isExported(q->b.opsig.name, o->b.oblit.export);
Sequence_Next
}
sortATOps(at);
#ifdef COPYSIGS
newAssignTypes(at, 1);
#else
at->b.atlit.f.typesAreAssigned = TRUE;
#endif
at->b.atlit.f.isVector = o->b.oblit.f.isVector;
if (at->b.atlit.f.isVector) {
at->b.atlit.f.cannotBeConformedTo = TRUE;
at->b.atlit.codeOID = o->b.oblit.codeOID;
}
if (o->b.oblit.f.dependsOnTypeVariable) {
assert(o->b.oblit.f.writeSeparately == FALSE);
at->b.atlit.f.isManifest = FALSE;
at->b.atlit.f.writeSeparately = FALSE;
at->b.atlit.f.dependsOnTypeVariable = TRUE;
at->b.atlit.id = AllocateOID();
OTInsert(at, at->b.atlit.id);
} else if (o->b.oblit.f.typeDependsOnTypeVariable) {
at->b.atlit.f.isManifest = FALSE;
at->b.atlit.f.writeSeparately = FALSE;
at->b.atlit.f.dependsOnTypeVariable = TRUE;
at->b.atlit.id = AllocateOID();
OTInsert(at, at->b.atlit.id);
} else {
defineGlobal(at, 0);
}
return(at);
}
NodePtr getExportedATOfObject(o, fAT)
NodePtr o, fAT;
{
NodePtr exports, export, ops, p, q, at;
OID opID;
Boolean *isDefined;
int numSigs;
Symbol st, newst;
register int i, j;
assert(o->tag == P_OBLIT);
assert(fAT->tag == P_ATLIT);
exports = o->b.oblit.export;
if (exports != NULL) {
assert(exports->tag == P_EXPORT);
exports = exports->b.export.syms;
}
numSigs = Sequence_Length(exports);
at = Construct(P_ATLIT, 4, o->b.oblit.sfname, NULL, NULL, NULL);
at->b.atlit.f.immutable = o->b.oblit.f.immutable;
TRACE4(copy, 1, "GetExportedATOf %s %s 0x%08x -> 0x%08x",
tagNames[(int)o->tag],
o->b.oblit.name == NN ? "unknown" :
ST_SymbolName(o->b.oblit.name->b.symdef.symbol),
o,
at);
st = ST_Fetch(o->b.oblit.name->b.symdef.symbol);
at->b.atlit.name =
buildComplicatedSymbol(P_SYMDEF, ST_SymbolName(st), 0, "_XAT");
at->b.atlit.name->b.symdef.symbol =
ST_Create(NN, at->b.atlit.name->b.symdef.ident);
newst = ST_Fetch(at->b.atlit.name->b.symdef.symbol);
at->b.atlit.name->b.symdef.ident = newst->itsIdent;
newst->value.value = at;
newst->value.ATinfo = refToBuiltin(B_INSTAT, SIGNATUREINDEX);
newst->value.CTinfo = refToBuiltin(B_INSTCT, SIGNATUREINDEX);
newst->hasValue = TRUE;
newst->isManifest = TRUE;
at->b.atlit.ops = NULL;
isDefined = (Boolean *) calloc((unsigned)numSigs, sizeof(Boolean));
ops = fAT->b.atlit.ops;
Sequence_For(p, ops)
assert(p->tag == P_OPSIG);
q = p->b.opsig.name;
assert(q->tag == P_OPNAME);
opID = q->b.opname.id;
for (j = 0; j < numSigs; j++) {
export = exports->b.children[j];
assert(export->tag == P_OPNAME);
if (export->b.opname.id == opID) {
NodePtr theop;
isDefined[j] = TRUE;
theop = findObjectOperation(o, export);
if (theop->b.opdef.isPrivate) {
ErrorMessage(theop, "Private operations may not be exported");
}
#ifdef COPYSIGS
Sequence_Add(&at->b.atlit.ops, copyTree(p, TRUE));
#else
Sequence_Add(&at->b.atlit.ops, p);
#endif
break;
}
}
Sequence_Next
if (Sequence_Length(at->b.atlit.ops) != numSigs) {
for (i = 0; i < numSigs; i++) {
if (!isDefined[i]) {
BeginErrorMessage(o);
(void) sprintf(error_buffer, "Exported operation %s is not defined",
ON_Name(exports->b.children[i]->b.opname.id));
ErrorWrite(error_buffer);
EndErrorMessage();
}
}
}
if (Sequence_Length(at->b.atlit.ops) > 1) {
TRACE1(atctsort, 2, "QSorting at %s", ATName(at));
qsort((char *)&(at->b.atlit.ops->b.children[0]),
Sequence_Length(at->b.atlit.ops),
sizeof(NodePtr),
compareSigs);
for (i = 0; i < Sequence_Length(at->b.atlit.ops); i++) {
TRACE2(atctsort, 4, "Operation %s has number %d",
SigName(at->b.atlit.ops->b.children[i]), i);
}
}
defineGlobal(at, 0);
at->b.atlit.f.isVector = o->b.oblit.f.isVector;
if (at->b.atlit.f.isVector) {
at->b.atlit.f.cannotBeConformedTo = TRUE;
at->b.atlit.codeOID = o->b.oblit.codeOID;
}
at->b.atlit.f.writeSeparately = fAT->b.atlit.f.writeSeparately;
at->b.atlit.f.isManifest = fAT->b.atlit.f.isManifest;
at->b.atlit.f.dependsOnTypeVariable = fAT->b.atlit.f.dependsOnTypeVariable;
return(at);
}
void initializebuildATs()
{
}
extern Boolean internalConforms();
Boolean isAnAT(p)
register NodePtr p;
{
register Symbol st;
if ((int) p <= 0x200) {
return(FALSE);
} else if (p->tag == P_ATLIT) {
return (TRUE);
} else if (p->tag == P_BUILTINLIT) {
return(p->b.builtinlit.whichType != KARRAY &&
p->b.builtinlit.whichType != KVECTOR);
} else if (p->tag == P_SYMREF) {
st = ST_Fetch(p->b.symref.symbol);
return(st->isManifest && isAnAT(st->value.value));
} else if (p->tag == P_OBLIT) {
return(p->b.oblit.instat != NULL);
} else if (p->tag == P_GLOBALREF) {
resolveGlobal(p, (ValuePtr)NULL);
return(isAnAT(p->b.globalref.value));
} else {
return(FALSE);
}
}
/*
* We need to copy all nodes making this object.
*/
NodePtr _copyTree(p)
register NodePtr p;
{
register NodePtr newNode;
register int i, nRealChildren;
if ((int) p <= 0x200) {
newNode = p;
} else if ((newNode = (NodePtr) Map_Lookup(copyMap, (int)p)) != (NodePtr) NIL) {
/* do nothing, newNode is the right thing to return */
} else if ((p->tag == P_ATLIT || p->tag == P_OBLIT) && p->b.atlit.f.writeSeparately) {
assert(p->b.atlit.id != 0);
newNode = Construct(P_GLOBALREF, 0);
newNode->b.globalref.id = p->b.atlit.id;
newNode->b.globalref.value = p;
} else {
nRealChildren = p->nChildren - p->firstChild;
newNode = F_NewNode(p->tag, nRealChildren);
newNode->nChildren += nRealChildren;
newNode->lineNumber = p->lineNumber;
Map_Insert(copyMap, (int)p, (int)newNode);
for (i = 0; i < newNode->firstChild; i++)
newNode->b.children[i] = p->b.children[i];
switch (p->tag) {
case P_SYMDEF:
case P_SYMREF:
copySymbol(newNode, p);
break;
case P_INVOC:
if (doClearSymbols) newNode->b.invoc.resultTypeOID = 0;
for (i = newNode->firstChild; i < newNode->nChildren; i++)
newNode->b.children[i] = COPYTREE(p->b.children[i]);
break;
case P_VECTORLIT:
if (doClearSymbols) newNode->b.vectorlit.vectorType = NN;
for (i = newNode->firstChild; i < newNode->nChildren; i++)
newNode->b.children[i] = COPYTREE(p->b.children[i]);
break;
case P_OBLIT:
case P_ATLIT:
TRACE4(copy, 1, "Copying %s %s 0x%08x -> 0x%08x",
tagNames[(int)p->tag],
p->b.oblit.name == NN ? "unknown" :
ST_SymbolName(p->b.oblit.name->b.symdef.symbol),
p,
newNode);
if (doClearSymbols) {
newNode->b.oblit.setq = COPYTREE(p->b.oblit.setq);
newNode->b.oblit.name = COPYTREE(p->b.oblit.name);
newNode->b.oblit.name->b.symdef.symbol->isSelf = TRUE;
newNode->b.oblit.name->b.symdef.symbol->value.value = newNode;
newNode->b.oblit.id = 0;
newNode->b.oblit.codeOID = 0;
newNode->b.oblit.f.isManifest = FALSE;
newNode->b.oblit.f.writeSeparately = FALSE;
newNode->b.oblit.f.isTypeVariable = FALSE;
newNode->b.oblit.f.inExecutableConstruct = FALSE;
newNode->b.oblit.f.dependsOnTypeVariable = FALSE;
newNode->b.oblit.f.typesAreAssigned = FALSE;
newNode->b.oblit.f.typesHaveBeenChecked = FALSE;
if (p->tag == P_ATLIT) {
newNode->b.atlit.ops = COPYTREE(p->b.atlit.ops);
} else {
newNode->b.oblit.myat = NULL;
newNode->b.oblit.instat = NULL;
newNode->b.oblit.export = COPYTREE(p->b.oblit.export);
newNode->b.oblit.decls = COPYTREE(p->b.oblit.decls);
newNode->b.oblit.monitor = COPYTREE(p->b.oblit.monitor);
newNode->b.oblit.ops = COPYTREE(p->b.oblit.ops);
newNode->b.oblit.process = COPYTREE(p->b.oblit.process);
}
} else {
assert(!p->b.atlit.f.writeSeparately);
if (p->b.atlit.id != 0) {
newNode->b.atlit.id = AllocateOID();
OTInsert(newNode, newNode->b.atlit.id);
}
for (i = newNode->firstChild; i < newNode->nChildren; i++)
newNode->b.children[i] = COPYTREE(p->b.children[i]);
if (newNode->tag == P_OBLIT && newNode->b.oblit.codeOID != 0) {
newNode->b.oblit.codeOID = AllocateOID();
OTInsert(newNode, newNode->b.oblit.codeOID);
}
}
break;
case P_OPSIG:
newNode->b.opsig.name = p->b.opsig.name;
newNode->b.opsig.params = COPYTREE(p->b.opsig.params);
newNode->b.opsig.results = COPYTREE(p->b.opsig.results);
if (doClearSymbols) {
newNode->b.opsig.where = p->b.opsig.where;
} else {
newNode->b.opsig.where = COPYTREE(p->b.opsig.where);
}
break;
case P_PARAM:
newNode->b.param.sym = COPYTREE(p->b.param.sym);
newNode->b.param.type = p->b.param.type;
newNode->b.param.constraint = p->b.param.constraint;
break;
default:
for (i = newNode->firstChild; i < newNode->nChildren; i++)
newNode->b.children[i] = COPYTREE(p->b.children[i]);
break;
}
}
return(newNode);
}
NodePtr copyTree(p, clearSymbols)
NodePtr p;
Boolean clearSymbols;
{
NodePtr result;
TRACE3(copy, 1, "Copying %s 0x%08x, dCC = %s",
tagNames[(int)p->tag], p, clearSymbols ? "true" : "false");
doClearSymbols = clearSymbols;
copyMap = Map_Create();
result = COPYTREE(p);
Map_Destroy(copyMap);
return(result);
}